home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / program / mclk105.zip / MCLK.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-16  |  3KB  |  150 lines
  1. {$M 5120,0,655360}
  2. {$N-,E- no math support needed}
  3. {$X- function calls may not be discarded}
  4. {$I- disable I/O checking (trap errors by checking IOResult)}
  5.  
  6. PROGRAM Moving_Clock;
  7. USES CRT, DOS;
  8.  
  9. VAR
  10.   MaxX, MaxY,
  11.   MidX, MidY : BYTE;
  12.   Ratio : REAL;
  13.  
  14. PROCEDURE showhelp;
  15. BEGIN
  16.   WriteLn ('MCLK v1.05 - Free DOS thing: moving time display.'                       );
  17.   WriteLn ('March 16, 1996. Copyright (c) 1996 by David Daniel Anderson - Reign Ware');
  18.   WriteLn ('Usage:  MCLK'                                                            );
  19.   Halt;
  20. END;
  21.  
  22. PROCEDURE Cursor (CONST on : BOOLEAN);
  23. VAR
  24.   r : REGISTERS;
  25. BEGIN
  26.   r. AH := $03;            {----get cursor shape on page 0               }
  27.   r. BH := $00;            {----to be exact use function 2 to obtain page}
  28.   Intr ($10, r);
  29.  
  30.   IF ((r. CX < $2000) AND NOT (on)) OR
  31.      ((r. CX >= $2000) AND on)
  32.   THEN
  33.   BEGIN
  34.     r. AH := $01;
  35.     r. CX := r. CX XOR $2000;   {----toggle bit if neccesary}
  36.     Intr ($10, r);
  37.   END;
  38. END; {of cursor}
  39.  
  40. FUNCTION leadingzero (CONST w : WORD) : STRING;
  41. VAR
  42.   s : STRING;
  43. BEGIN
  44.   Str (w: 0, s);
  45.   IF Length (s) = 1 THEN
  46.     s := '0' + s;
  47.   leadingzero := s;
  48. END;
  49.  
  50. FUNCTION DisplayDate : BOOLEAN;
  51. VAR
  52.   h, mi, s, u : WORD;
  53.   date_time : DATETIME;
  54.  
  55.   Angle, X, Y : INTEGER;
  56.   QuadAngle : REAL;
  57.   Xofs, Yofs : BYTE;
  58.  
  59. BEGIN
  60.   GetTime (h, mi, s, u);
  61.   IF ((s MOD 5) = 0) THEN
  62.   BEGIN
  63.     ClrScr;
  64.  
  65.     Angle := s * 6;
  66.     QuadAngle := (Abs (Angle MOD 90) * Pi / 180.0);
  67.     Xofs := Trunc (MidY * Cos (QuadAngle));
  68.     Yofs := Trunc (MidY * Sin (QuadAngle)) + 1;
  69.  
  70.     (* Xofs goes from MidY downto 1; Yofs goes from 1 to MidY *)
  71.  
  72.     IF (Angle >= 270) THEN
  73.     BEGIN
  74.       X := MidX - Trunc (Ratio * Xofs);
  75.       Y := MidY - Yofs;
  76.     END
  77.     ELSE
  78.     IF (Angle >= 180) THEN
  79.     BEGIN
  80.       X := MidX - Trunc (Ratio * Yofs);
  81.       Y := MidY + Xofs;
  82.     END
  83.     ELSE
  84.     IF (Angle >= 90) THEN
  85.     BEGIN
  86.       X := MidX + Trunc (Ratio * Xofs);
  87.       Y := MidY + Yofs;
  88.     END
  89.     ELSE
  90.     IF (Angle >= 0) THEN
  91.     BEGIN
  92.       X := MidX + Trunc (Ratio * Yofs);
  93.       Y := MidY - Xofs;
  94.     END;
  95.  
  96.     GotoXY (X - 2, Y + 1);
  97.  
  98.     WITH date_time DO
  99.     BEGIN
  100.       Hour := (h);
  101.       Min  := (mi);
  102.       Write (Hour, ':', leadingzero (Min));
  103.     END;
  104.     DisplayDate := TRUE;
  105.   END
  106.   ELSE
  107.     DisplayDate := FALSE;
  108. END;
  109.  
  110. VAR
  111.   Paused : INTEGER;
  112.   k : CHAR;
  113.   ta : BYTE;
  114.  
  115. BEGIN
  116.   CheckBreak := FALSE;
  117.   IF ParamCount <> 0 THEN showhelp;
  118.   Cursor (FALSE);
  119.  
  120.   WriteLn ('Please wait one moment...');
  121.  
  122.     MaxX := Lo (WindMax);                     { <                  }
  123.     MaxY := Hi (WindMax);                     { <                  }
  124.     MidX := MaxX DIV 2;                       { < Global variables }
  125.     MidY := MaxY DIV 2;                       { <                  }
  126.     Ratio := Sqrt ((MaxX + 1) / (MaxY + 1));  { <                  }
  127.  
  128.   ta := 9;
  129.   WHILE NOT KeyPressed DO BEGIN
  130.     ta := (Succ (ta));  { use colors 10 - 15 }
  131.     IF ta = 16 THEN ta := 10;
  132.     TextAttr := ta;
  133.  
  134.     REPEAT
  135.       Delay (300); { 0.3 seconds }
  136.     UNTIL DisplayDate OR KeyPressed;
  137.  
  138.     Paused := 0;
  139.     REPEAT
  140.       Inc (Paused, 100);
  141.       Delay (100);
  142.     UNTIL KeyPressed OR (Paused = 4000);
  143.   END;
  144.   Cursor (TRUE);
  145.   NormVideo;
  146.   ClrScr;
  147.  
  148.   WHILE KeyPressed DO k := ReadKey;  { empty keyboard buffer }
  149. END.
  150.